home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / misc.swg / 0123_Is the CPU doing something?.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  4.6 KB  |  185 lines
  1. {
  2.   Sometimes you have trouble to know if the computer really does something
  3.   or if it has gone into an endless loop. This is a problem that I have
  4.   got when I constructed some programs which done some heavy numerical
  5.   computations. (Some of them take about 15 minutes to run on a 66 MHz
  6.   486-DX2.)
  7.  
  8.   So, to solve my problems I created an object which implement a spinning
  9.   indicator that gives information on the screen that something is really
  10.   going on. I haven't put in much comments but I think it will be easy to
  11.   follow the code anyway. After the code of the SpinU unit is a simple
  12.   demo program.
  13.  
  14.   Enjoy!
  15.  
  16.   By Mats Dahlin, 1994-10-13
  17.  
  18.   If you have any suggestions/questions, please a message to
  19.       CompuServe: 70622,157
  20.       Internet  : 70622.157@compuserve.comsend E-mail to
  21. }
  22.  
  23. unit SpinU;
  24.  
  25. {********************************************************************}
  26. interface
  27. {********************************************************************}
  28.  
  29. type
  30.   TSpin = object
  31.     x, y     : Byte;
  32.     ColorAttr: Byte;
  33.     Index    : Byte;
  34.     SpinDelay: Byte;
  35.     Clockwise: Boolean;
  36.     Counter  : Byte;
  37.     procedure Init(InitX, InitY : Byte;        { Coordinate of the "spinner" }
  38.                    InitColorAttr: Byte;       { Color attribute of "spinner" }
  39.                    InitIndex    : Byte;             { Initial spin character }
  40.                    InitSpinDelay: Byte;{ Delay before next turn of "spinner" }
  41.                    InitClockwise: Boolean);         { Spin clockwise or... ? }
  42.     procedure Display;
  43.     procedure Update;
  44.     procedure Clear;
  45.   end;
  46.  
  47. {********************************************************************}
  48. implementation
  49. {********************************************************************}
  50.  
  51. uses
  52.   Crt;
  53.  
  54. procedure TSpin.Init(InitX, InitY : Byte;
  55.                      InitColorAttr: Byte;
  56.                      InitIndex    : Byte;
  57.                      InitSpinDelay: Byte;
  58.                      InitClockwise: Boolean);
  59. begin
  60.   x := InitX;
  61.   y := InitY;
  62.   ColorAttr := InitColorAttr;
  63.   Index := InitIndex;
  64.   SpinDelay := InitSpinDelay;
  65.   Counter := 0;
  66.   Clockwise := InitClockwise;
  67.   Display;
  68. end;
  69.  
  70. {************************************************}
  71.  
  72. procedure TSpin.Display;
  73. const
  74.   CSpinCh: array [1..4] of Char = ('/', '-', '\', '|');
  75. var
  76.   OldAttr: Byte;
  77. begin
  78.   OldAttr := TextAttr;
  79.   TextColor(ColorAttr);
  80.   Gotoxy(x, y);
  81.   Write(CSpinCh[Index]);
  82.   TextAttr := OldAttr;
  83. end;
  84.  
  85. {************************************************}
  86.  
  87. procedure TSpin.Update;
  88. begin
  89.   Display;
  90.   Inc(Counter);
  91.   if (Counter>=SpinDelay) then
  92.   case Clockwise of
  93.     True : begin
  94.              Inc(Index);
  95.              if (Index=5) then
  96.                Index := 1;
  97.              Counter := 0;
  98.            end;
  99.     False: begin
  100.              Dec(Index);
  101.              if (Index=0) then
  102.                Index := 4;
  103.              Counter := 0;
  104.            end;
  105.   end;
  106. end;
  107.  
  108. {************************************************}
  109.  
  110. procedure TSpin.Clear;
  111. begin
  112.   Gotoxy(x, y);
  113.   Write(#32);
  114. end;
  115.  
  116. {********************************************************************}
  117.  
  118. end.
  119.  
  120. { And here comes the demo program... }
  121.  
  122. program SpinTest;
  123.  
  124. uses
  125.   Dos, Crt, SpinU;
  126.  
  127. const
  128.   NoOfSpinners = 15;
  129.   NoOfRows     = 4;
  130.  
  131. var
  132.   Spin: array [1..NoOfSpinners, 1..NoOfRows] of TSpin;
  133.   i, j: Integer;
  134.  
  135. {************************************************}
  136.  
  137. procedure CursorOff;
  138. var
  139.   Regs: Registers;
  140. begin
  141.   FillChar(Regs, SizeOf(Regs), 0);
  142.   Regs.AH := $01;
  143.   Regs.CX := $2000;
  144.   Intr($10, Regs);
  145. end;
  146.  
  147. {************************************************}
  148.  
  149. procedure CursorOn;
  150. var
  151.   Regs: Registers;
  152. begin
  153.   FillChar(Regs, SizeOf(Regs), 0);
  154.   Regs.AH := $0F;
  155.   Intr($10, Regs);
  156.   if ((Regs.AL and $07)=$07) then
  157.     Regs.CX := $0C0D
  158.   else
  159.     Regs.CX := $0607;
  160.   Regs.AH := $01;
  161.   Intr($10, Regs);
  162. end;
  163.  
  164. {************************************************}
  165.  
  166. begin
  167.   CursorOff;
  168.   Gotoxy(1, 12);
  169.   Writeln('SPINTEST - By Mats Dahlin, 1994-10-13');
  170.   Writeln('(A demo program of the SpinU unit)');
  171.   for i := 1 to NoOfSpinners do                         { Setup the spinners }
  172.     for j := 1 to NoOfRows do
  173.       Spin[i, j].Init(5*i, 2*j, i, j, 15*j, Odd(j));
  174.   repeat                                                  { Let them spin... }
  175.     for i := 1 to NoOfSpinners do
  176.       for j := 1 to NoOfRows do
  177.         Spin[i, j].Update;
  178.   until KeyPressed;
  179.   for i := 1 to NoOfSpinners do     { These loops aren't really necessary in }
  180.     for j := 1 to NoOfRows do                  { this little demo program... }
  181.       Spin[i, j].Clear;
  182.   ClrScr;
  183.   CursorOn;
  184. end.
  185.